
 1000  *---------------------------------
 1010  *      VARIABLE CROSS REFERENCE
 1020  *       FOR APPLESOFT PROGRAMS
 1030  *---------------------------------
 1040  ZZ.BEG .EQ $8800
 1050         .OR ZZ.BEG
 1060         .TF B.VCR
 1070  *---------------------------------
 1080         LDA #$4C     AMPERSAND VECTOR
 1090         STA $3F5
 1100         LDA #VCR
 1110         STA $3F6
 1120         LDA /VCR
 1130         STA $3F7
 1140         RTS
 1150  *---------------------------------
 1160  PNTR   .EQ $18,19   POINTER INTO PROGRAM
 1170  DATA   .EQ $1A THRU $1D
 1180  LZFLAG .EQ $1A      LEADING ZERO FLAG
 1190  NEXTLN .EQ $1A,1B   ADDRESS OF NEXT LINE
 1200  LINNUM .EQ $1C,1D   CURRENT LINE NUMBER
 1210  STPNTR .EQ $1E,1F   POINTER INTO VARIABLE TABLE
 1220  TPTR   .EQ $9B,9C   TEMP POINTER
 1230  SYMBOL .EQ $9D THRU $A4  8 BYTES
 1240  VARNAM .EQ SYMBOL+1
 1250  HSHTBL .EQ $280
 1260  ENTRY.SIZE .EQ $A5,A6
 1270  *---------------------------------
 1280  PRGBOT .EQ $67,68   BEGINNING OF PROGRAM
 1290  LOMEM  .EQ $69,6A   BEGINNING OF VARIABLE SPACE
 1300  EOT    .EQ $6B,6C   END OF VARIABLE TABLE
 1310  *---------------------------------
 1320  TKN.REM    .EQ 178
 1330  TKN.DATA   .EQ 131
 1340  *---------------------------------
 1350  MON.CH     .EQ $24
 1360  MON.PRBL2  .EQ $F94A
 1370  MON.COUT   .EQ $FDED
 1380  MON.CROUT  .EQ $FD8E
 1390  *---------------------------------
 1400  VCR
 1410         JSR INITIALIZATION
 1420  .1     JSR PROCESS.LINE
 1430         BNE .1       UNTIL END OF PROGRAM
 1440         JSR PRINT.REPORT
 1450         JSR INITIALIZATION  ERASE VARIABLE TABLE
 1452         LDA #0       CLEAR $A4 SO APPLESOFT WILL
 1454         STA $A4      WORK CORRECTLY
 1460         RTS
 1470  *---------------------------------
 1480  INITIALIZATION
 1490         LDA LOMEM
 1500         STA EOT
 1510         LDA LOMEM+1
 1520         STA EOT+1
 1530         LDX #52      # OF BYTES FOR HASH POINTERS
 1540         LDA #0
 1550  .1     STA HSHTBL-1,X
 1560         DEX
 1570         BNE .1
 1580         LDA PRGBOT
 1590         STA PNTR
 1600         LDA PRGBOT+1
 1610         STA PNTR+1
 1620         RTS
 1630  *---------------------------------
 1640  PROCESS.LINE
 1650         LDY #3       CAPTURE POINTER AND LINE #
 1660  .1     LDA (PNTR),Y
 1670         STA DATA,Y
 1680         DEY
 1690         BPL .1
 1692         LDA DATA+1   CHECK IF END
 1694         BEQ .3       YES
 1700         CLC          SKIP OVER DATA
 1710         LDA PNTR
 1720         ADC #4
 1730         STA PNTR
 1740         BCC .2
 1750         INC PNTR+1
 1760  .2     JSR SCAN.FOR.VARIABLES
 1770         LDA DATA
 1780         STA PNTR
 1790         LDA DATA+1
 1800         STA PNTR+1
 1810  *      BNE .3
 1820  .3     RTS
 1830  *---------------------------------
 1840  SCAN.FOR.VARIABLES
 1850  .1     JSR GET.NEXT.VARIABLE
 1860         BEQ .3       END OF LINE
 1870         JSR PACK.VARIABLE.NAME
 1880         JSR SEARCH.VARIABLE.TABLE
 1890         BCC .2       FOUND SAME VARIABLE
 1900         LDA #0
 1910         STA SYMBOL+4 START OF LINE NUMBER CHAIN
 1920         STA SYMBOL+5
 1930         LDA LINNUM+1 MSB FIRST
 1940         STA SYMBOL+6
 1950         LDA LINNUM
 1960         STA SYMBOL+7
 1970         LDA #8       ADD 8 BYTE ENTRY
 1980         JSR ADD.NEW.ENTRY
 1990         JMP .1
 2000  .2     JSR SEARCH.LINE.CHAIN
 2010         BCC .1       FOUND SAME LINE NUMBER
 2020         LDA #4       ADD 4 BYTE ENTRY
 2030         JSR ADD.NEW.ENTRY
 2040         JMP .1
 2050  .3     RTS
 2060  *---------------------------------
 2070  GET.NEXT.VARIABLE
 2080  .1     JSR NEXT.CHAR.NOT.QUOTE
 2090         BEQ .2       END OF LINE
 2100         CMP #TKN.DATA
 2110         BEQ .3
 2120         CMP #TKN.REM
 2130         BEQ .2       SKIP TO NEXT LINE
 2140         JSR LETTER   LETTER?
 2150         BCC .1       NO, KEEP LOOKING
 2160  .2     RTS
 2170  *   DATA, SO SKIP TO NEXT STATEMENT
 2180  .3     JSR NEXT.CHAR.NOT.QUOTE
 2190         BEQ .2       EOL, RETURN
 2200         CMP #':      COLON?
 2210         BNE .3       NOT END YET
 2220         BEQ .1       ...ALWAYS
 2230  *---------------------------------
 2240  NEXT.CHAR.NOT.QUOTE
 2250  .1     JSR NEXT.CHAR
 2260         BEQ .2       EOL, RETURN
 2270         CMP #'"      QUOTE?
 2280         BEQ .3       YES, SCAN OVER QUOTATION
 2290  .2     RTS          RETURN
 2300  .3     JSR NEXT.CHAR
 2310         BEQ .2       EOL, RETURN
 2320         CMP #'"      TERMINAL QUOTE?
 2330         BNE .3       NOT YET
 2340         BEQ .1       ...ALWAYS
 2350  *---------------------------------
 2360  *      NEXT CHARACTER FROM LINE
 2370  *        CALL:  JSR NEXT.CHAR
 2380  *      RETURN:  (A)=CHAR FROM LINE
 2390  *               IF CHAR .NE. EOL,
 2400  *                   INCREMENT PNTR AND
 2410  *                   STATUS Z=0
 2420  *               IF CHAR .EQ. EOL,
 2430  *                   STATUS Z=1
 2440  *---------------------------------
 2450  NEXT.CHAR
 2460         LDY #0
 2470         LDA (PNTR),Y
 2480         BEQ .1       EOL
 2490         INC PNTR     BUMP POINTER
 2500         BNE .1
 2510         INC PNTR+1
 2520  .1     RTS
 2530  *---------------------------------
 2540  PACK.VARIABLE.NAME
 2550         STA VARNAM   FIRST CHAR OF NAME
 2560         LDA #'       BLANKS FOR OTHER TWO CHARS
 2570         STA VARNAM+1
 2580         STA VARNAM+2
 2590         JSR NEXT.CHAR
 2600         BEQ .5       END OF LINE
 2610         JSR LTRDIG
 2620         BCC .2       NOT LETTER OR DIGIT
 2630         STA VARNAM+1
 2640  .1     JSR NEXT.CHAR IGNORE EXCESS NAME
 2650         BEQ .5       END OF LINE
 2660         JSR LTRDIG
 2670         BCS .1       LETTER OR DIGIT
 2680  .2     CMP #'$      DOLLAR SIGN?
 2690         BEQ .3       YES
 2700         CMP #'%      PER CENT?
 2710         BNE .4       NO
 2720  .3     STA VARNAM+2
 2730         JSR NEXT.CHAR
 2740         BEQ .5       END OF LINE
 2750  .4     CMP #'(      LEFT PAREN?
 2752         BEQ .6       YES
 2754         CMP #'"      QUOTE?
 2760         BNE .5       NO
 2762         LDA PNTR     YES, BACK UP POINTER
 2763         BNE .7
 2764         DEC PNTR+1
 2765  .7     DEC PNTR
 2766         RTS
 2770  .6     LDA VARNAM+2 SET HIGH BIT
 2780         ORA #$80     TO FLAG ARRAY
 2790         STA VARNAM+2 REFERENCE
 2800  .5     RTS
 2810  *---------------------------------
 2820  SEARCH.VARIABLE.TABLE
 2830         SEC          CONVERT 1ST CHAR TO
 2840         LDA VARNAM   HASH TABLE INDEX
 2850         SBC #'A
 2860         ASL
 2870         ADC #HSHTBL
 2880         STA STPNTR
 2890         LDA /HSHTBL
 2900         ADC #0
 2910         STA STPNTR+1
 2920  *---   FALL INTO CHAIN SEARCH ROUTINE
 2930  *---------------------------------
 2940  CHAIN.SEARCH
 2950  .1     LDY #0       POINT AT POINTER IN ENTRY
 2960         LDA (STPNTR),Y
 2970         STA TPTR
 2980         INY
 2990         LDA (STPNTR),Y
 3000         BEQ .4       END OF CHAIN, NOT IN TABLE
 3010         STA TPTR+1
 3020         LDX #2       2 MORE CHARS IN SYMBOL
 3030         LDY #2       POINT AT NAME IN ENTRY
 3040  .2     LDA (TPTR),Y COMPARE NAMES
 3050         CMP SYMBOL,Y
 3060         BCC .3       NOT THIS ONE, BUT KEEP LOOKING
 3070         BNE .4       NOT IN THIS CHAIN
 3080         DEX
 3090         BEQ .5       NAME IS THE SAME
 3100         INY          NEXT BYTE PAIR
 3110         BNE .2       ...ALWAYS
 3120  *---------------------------------
 3130  .3     JSR .5       UPDATE POINTER, CLEAR CARRY
 3140         BCC .1       ...ALWAYS
 3150  *---------------------------------
 3160  .4     SEC          DID NOT FIND
 3170         RTS
 3180  *---------------------------------
 3190  .5     LDA TPTR
 3200         STA STPNTR
 3210         LDA TPTR+1
 3220         STA STPNTR+1
 3230         CLC
 3240         RTS
 3250  *---------------------------------
 3260  ADD.NEW.ENTRY
 3270         STA ENTRY.SIZE
 3280         CLC          SEE IF ROOM
 3290         LDX #1
 3300         LDY #0
 3310         STY ENTRY.SIZE+1
 3320  .1     LDA (STPNTR),Y  GET CURRENT POINTER
 3330         STA SYMBOL,Y
 3340         LDA EOT,Y
 3350         STA (STPNTR),Y
 3360         STA TPTR,Y
 3370         ADC ENTRY.SIZE,Y
 3380         STA EOT,Y
 3390         INY
 3400         DEX
 3410         BPL .1
 3420  *---   SEE IF GOING TO BE ENOUGH ROOM
 3430         LDA EOT
 3440         CMP #ZZ.BEG
 3450         LDA EOT+1
 3460         SBC /ZZ.BEG
 3470         BCS .3       MEM FULL ERR
 3480  *---   MOVE ENTRY INTO VARIABLE TABLE
 3490         LDY ENTRY.SIZE
 3500         DEY
 3510  .2     LDA SYMBOL,Y
 3520         STA (TPTR),Y
 3530         DEY
 3540         BPL .2
 3550         LDA TPTR
 3560         STA STPNTR
 3570         LDA TPTR+1
 3580         STA STPNTR+1
 3590         RTS
 3600  .3     JMP MEM.FULL.ERR
 3610  MEM.FULL.ERR
 3620         BRK
 3630  *---------------------------------
 3640  SEARCH.LINE.CHAIN
 3650         CLC          ADJUST POINTER TO START
 3660         LDA STPNTR   OF LINE # CHAIN
 3670         ADC #4
 3680         STA SYMBOL
 3690         LDA STPNTR+1
 3700         ADC #0
 3710         STA SYMBOL+1
 3720         LDA #SYMBOL
 3730         STA STPNTR
 3740         LDA /SYMBOL
 3750         STA STPNTR+1
 3760         LDA LINNUM   PUT LINE NUMBER INTO SYMBOL
 3770         STA SYMBOL+3
 3780         LDA LINNUM+1
 3790         STA SYMBOL+2
 3800         JMP CHAIN.SEARCH
 3810  *---------------------------------
 3820  PRINT.REPORT
 3830         LDA #'A      START WITH A'S
 3840  .1     STA VARNAM
 3850         SEC
 3860         SBC #'A      CONVERT TO HSHTBL INDEX
 3870         ASL
 3880         TAY
 3890         LDA HSHTBL+1,Y
 3900         BEQ .2       NO ENTRY FOR THIS LETTER
 3910         STA PNTR+1
 3920         LDA HSHTBL,Y
 3930         STA PNTR
 3940         JSR PRINT.LETTER.CHAIN
 3950  .2     INC VARNAM   NEXT LETTER
 3960         LDA VARNAM
 3970         CMP #'Z+1
 3980         BCC .1       STILL MORE LETTERS
 3990         RTS          FINISHED
 4000  *---------------------------------
 4010  LTRDIG
 4020         CMP #'0      DIGIT?
 4030         BCC LD1      NO
 4040         CMP #'9+1
 4050         BCC LD2      YES
 4060  LETTER
 4070         CMP #'A      LETTER?
 4080         BCC LD1      NO
 4090         CMP #'Z+1
 4100         BCC LD2      YES
 4110         CLC          NO
 4120  LD1    RTS
 4130  LD2    SEC
 4140         RTS
 4150  *---------------------------------
 4160  PRINT.LETTER.CHAIN
 4170  .1     LDA VARNAM   FIRST LETTER
 4180         JSR PRINT.CHAR
 4190         LDY #1
 4200  .2     INY
 4210         LDA (PNTR),Y REST OF NAME
 4220         AND #$7F
 4230         CMP #'       BLANK?
 4240         BEQ .3
 4250         JSR PRINT.CHAR
 4260  .3     CPY #3
 4270         BCC .2
 4280         LDA (PNTR),Y CHECK IF ARRAY
 4290         BPL .4
 4300         LDA #'(
 4310         JSR PRINT.CHAR
 4320  .4     CLC          POINT AT LINE # CHAIN
 4330         LDA PNTR
 4340         ADC #4
 4350         STA TPTR
 4360         LDA PNTR+1
 4370         ADC #0
 4380         STA TPTR+1
 4390         JSR PRINT.LINNUM.CHAIN
 4400         JSR MON.CROUT
 4410         LDY #1
 4420         LDA (PNTR),Y POINTER TO NEXT VARIABLE
 4430         BEQ .5       NO MORE
 4440         PHA
 4450         DEY
 4460         LDA (PNTR),Y
 4470         STA PNTR
 4480         PLA
 4490         STA PNTR+1
 4500         BNE .1       ...ALWAYS
 4510  .5     RTS
 4520  *---------------------------------
 4530  PRINT.LINNUM.CHAIN
 4540  .1     JSR TAB.NEXT.COLUMN
 4550         LDY #2       POINT AT LINE #
 4560         LDA (TPTR),Y
 4570         STA LINNUM+1
 4580         INY
 4590         LDA (TPTR),Y
 4600         STA LINNUM
 4610         JSR PRINT.LINE.NUMBER
 4620         LDY #1       SET UP NEXT POINTER
 4630         LDA (TPTR),Y
 4640         BEQ .2
 4650         PHA
 4660         DEY
 4670         LDA (TPTR),Y
 4680         STA TPTR
 4690         PLA
 4700         STA TPTR+1
 4710         BNE .1       ...ALWAYS
 4720  .2     RTS
 4730  *---------------------------------
 4740  TAB.NEW.LINE
 4750         JSR MON.CROUT
 4760  TAB.NEXT.COLUMN
 4770  .1     LDA #7       FIRST TAB STOP
 4780  .2     CMP MON.CH   CURSOR POSITION
 4790         BCS .3       PERFORM TAB
 4800         ADC #6       NEXT TAB STOP
 4810         CMP #33      END OF LINE?
 4820         BCC .2
 4830         BCS TAB.NEW.LINE  ...ALWAYS
 4840  .3     BEQ .4       ALREADY THERE
 4850         SBC MON.CH   CALCULATE # OF BLANKS
 4860         TAX
 4870         JSR MON.PRBL2
 4880  .4     RTS
 4890  *---------------------------------
 4900  PRINT.LINE.NUMBER
 4910         LDX #4       PRINT 5 DIGITS
 4920         STX LZFLAG   TURN ON LEADING ZERO FLAG
 4930  .1     LDA #'0      DIGIT=0
 4940  .2     PHA
 4950         SEC
 4960         LDA LINNUM
 4970         SBC PLNTBL,X
 4980         PHA
 4990         LDA LINNUM+1
 5000         SBC PLNTBH,X
 5010         BCC .3       LESS THAN DIVISOR
 5020         STA LINNUM+1
 5030         PLA
 5040         STA LINNUM
 5050         PLA
 5060         ADC #0       INCREMENT DIGIT
 5070         BNE .2       ...ALWAYS
 5080  .3     PLA
 5090         PLA
 5100         CMP #'0
 5110         BEQ .5       ZERO, MIGHT BE LEADING
 5120         SEC          TURN OFF LZFLAG
 5130         ROR LZFLAG
 5140  .4     JSR PRINT.CHAR
 5150         DEX
 5160         BPL .1
 5170         RTS
 5180  .5     BIT LZFLAG   LEADING ZERO FLAG
 5190         BMI .4       NO
 5200         LDA #'       BLANK
 5210         BNE .4       ...ALWAYS
 5220  PLNTBL .DA #1
 5230         .DA #10
 5240         .DA #100
 5250         .DA #1000
 5260         .DA #10000
 5270  PLNTBH .DA /1
 5280         .DA /10
 5290         .DA /100
 5300         .DA /1000
 5310         .DA /10000
 5320  *---------------------------------
 5330  PRINT.CHAR
 5340         ORA #$80
 5350         JSR MON.COUT
 5360         RTS
 5370  *---------------------------------
 5380  ZZ.END .EQ *
 5390  ZZ.SIZ .EQ ZZ.END-ZZ.BEG

